### REPLICATION FILE -- Figures 1 & 5
### Jonathan Homola, Natalie Jackson & Jeff Gill
### "A measure of survey mode differences"
### Electoral Studies 44: 255-274
### http://dx.doi.org/10.1016/j.electstud.2016.06.010

## clear environment, set seed, install/load packages
rm(list=ls())
set.seed(12435); options(stringsAsFactors=F)
#install.packages("ecodist")
library(ecodist)

## set working directory
#setwd(" ... ")

## read in the Brexit dataset 
brexit <- read.csv("HomolaJacksonGill_EntropyModeDifferences_Brexit.csv")
min.y <- 35
max.y <- 55



####
#### Figure 1 "Brexit" poll averages by survey mode
####
#pdf("Fig1.pdf", height = 6, width=8)
old_par <- par()
layout(matrix(c(1,2,3,3), ncol=2, byrow = TRUE), heights = c(0.9,0.1))
par(oma=c(2,3,2,1), mar=c(3,3,2,1))

# Internet polls
plot(0,0, type="n",
     xaxt="n", yaxt="n", xlab="", ylab="", main="",
     xlim=c(0,105),
     ylim=c(min.y, max.y))
lines(1:101, brexit[,4], lty=2, lwd=2, col="black")
lines(1:101, brexit[,5], lty=1, lwd=3, col="gray80")
text(c(102,102)-0.5, brexit[101,4:5]+c(1.5,-1.5), c("46.1", "44.9"), 
     col = c("black", "gray80"), cex=1.1)
segments(c(101,101), as.numeric(brexit[101,4:5]), 
         c(101,101), as.numeric(brexit[101,4:5])+c(0.8,-0.8),
         col="gray30", lty=3)

# Axis
axis(1, tick=T, 
     at = c(18, 48, 79, 101), labels = c("April 1", "May 1", "June 1", "June 23"),
     cex.axis=1, cex.lab=1.1, mgp=c(0.3, 0.3, 0), lty=1)
axis(2, tck=0, 
     at = seq(min.y, max.y,5),
     cex.axis=1.1, cex.lab=1.1, 
     mgp=c(0.3, 0.3, 0), lty=0)
title(ylab = "Percentage (%)", line = 1.5, cex.lab = 1.1, main = )
title(line = 0.8, main="Internet polls",
      font.main=1, cex.main=1.1)

# Telephone polls
plot(0,0, type="n",
     xaxt="n", yaxt="n", xlab="", ylab="", main="",
     xlim=c(0,105),
     ylim=c(min.y, max.y))
lines(1:101, brexit[,3], lty=2, lwd=2, col="black")
lines(1:101, brexit[,2], lty=1, lwd=3, col="gray80")
text(c(102,102)-0.5, brexit[101,c(3,2)]+c(-1.5,+1.5), c("46.7", "49.3"), 
     col = c("black", "gray80"), cex=1.1)
segments(c(101,101), as.numeric(brexit[101,c(3,2)]), 
         c(101,101), as.numeric(brexit[101,c(3,2)])+c(-0.8,+0.8),
         col="gray30", lty=3)

# Axis
axis(1, tick=T, 
     at = c(18, 48, 79, 101), labels = c("April 1", "May 1", "June 1", "June 23"),
     cex.axis=1, cex.lab=1.1, mgp=c(0.3, 0.3, 0), lty=1)
axis(2, tck=0, 
     at = seq(min.y, max.y,5),
     cex.axis=1.1, cex.lab=1.1, 
     mgp=c(0.3, 0.3, 0), lty=0)
title(line = 0.8, main="Telephone polls",
      font.main=1, cex.main=1.1)

# Legend
par(mar=c(0,0,0,0))
plot(0,0, type="n", axes = FALSE, xlab = "", ylab = "")
legend("center", ncol = 2, 
       legend = c("Remain in the EU", "Leave the EU"),
       cex=1.1, lty=c(1,2), col=c("gray80", "black"), lwd=c(3,2),
       bty="o")
par(old_par)
#dev.off()



####
#### Figure 5 Simulated regression results
####
rm(list=ls())
x <- rep(1:7, c(0.02, 0.02, 0.02, 0.88, 0.02, 0.02, 0.02) * 200)
y <- rep(1:7, c(0.45, 0.02, 0.02, 0.02, 0.02, 0.02, 0.45) * 200)
z <- corgen(x=x+y, r=0.5, epsilon=0.01)$y
ruler.df <- data.frame(x = seq(0.7, 7.3,length=400))
lm1 <- lm(z ~ x)
ci1 <- predict(lm1,ruler.df,interval="confidence",level=0.95)
lm2 <- lm(z ~ y)
ci2 <- predict(lm2,ruler.df,interval="confidence",level=0.95)
#pdf("Fig5.pdf")
par(mfrow=c(1,1),cex.lab=1.5)
plot(jitter(x),jitter(z),pch="+",col="grey60",xlab="7-Point Ordinal Variable",ylab="Interval Outcome")
for (i in 1:nrow(ruler.df)) segments(ruler.df[i,],ci1[i,2],ruler.df[i,],ci1[i,3],col="grey95",lwd=3)
abline(lm1,col="grey70",lwd=3)
points(jitter(x),jitter(z),pch="+",col="grey60")
points(jitter(y),jitter(z),pch="+",col="grey30")
abline(lm2,col="grey30",lwd=3)
#dev.off()